home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TOOLPAS2 / ATTR-A.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-28  |  2KB  |  98 lines
  1.  
  2. (*
  3.  * attr-a - clear Archive attribute in selected files, quickest method
  4.  *
  5.  * Author: S.H.Smith, 26-aug-90
  6.  *
  7.  *)
  8.  
  9. uses DOS, Tools, MdosIO;
  10.  
  11. const
  12.    subdirs: boolean = false;
  13.  
  14.  
  15. procedure usage;
  16. begin
  17.    writeln('usage: attr-a [-s] filespec ...');
  18.    writeln('example: attr-a -s *.zip');
  19.    halt;
  20. end;
  21.  
  22.  
  23. procedure clear_archive(fname:   PathStr);
  24. var
  25.    fd:      file;
  26. begin
  27.    writeln('   ',fname);
  28.    assign(fd,fname);
  29.    SetFAttr(fd, 0);
  30.    if DosError <> 0 then
  31.       writeln(^G'Can''t clear attributes on [',fname,'].');
  32. end;
  33.  
  34.  
  35. procedure dofiles (pattern:   PathStr);
  36. var
  37.    DirInfo:       SearchRec;
  38.    first:         boolean;
  39.  
  40. const
  41.    dir:           DirStr = '';
  42.    name:          NameStr = '';
  43.    ext:           ExtStr = '';
  44.  
  45. begin
  46.    FSplit(pattern,dir,name,ext);
  47.  
  48.    if (name[1] = '/') or (name[1] = '-') then
  49.    begin
  50.       case upcase(name[2]) of
  51.          'S':  subdirs := true;
  52.          else  usage;
  53.       end;
  54.       exit;
  55.    end;
  56.  
  57.    first := true;
  58.    FindFirst(pattern,dos.Archive,DirInfo);
  59.    while (DosError = 0) do
  60.    begin
  61.       if (DirInfo.attr and dos.Archive) <> 0 then
  62.       begin
  63.          if first then
  64.             writeln(pattern);
  65.          first := false;
  66.          clear_archive(dir+DirInfo.name);
  67.       end;
  68.       FindNext(DirInfo);
  69.    end;
  70.  
  71.    if subdirs then
  72.    begin
  73.       FindFirst(dir+'*.*',dos.Directory,DirInfo);
  74.       while (DosError = 0) do
  75.       begin
  76.          if (DirInfo.attr and dos.Directory) <> 0 then
  77.             if DirInfo.name[1] <> '.' then
  78.             begin
  79.                FSplit(pattern,dir,name,ext);
  80.                dofiles(dir+DirInfo.name+'\'+name+ext);
  81.             end;
  82.          FindNext(DirInfo);
  83.       end;
  84.    end;
  85. end;
  86.  
  87.  
  88. var
  89.    i: integer;
  90. begin
  91.    if paramcount < 1 then
  92.       usage;
  93.  
  94.    for i := 1 to paramcount do
  95.       dofiles(paramstr(i));
  96. end.
  97.  
  98.